perm filename MKVIC.FAI[1,BGB] blob sn#015995 filedate 1972-12-06 generic text, type T, neo UTF8
00100	TITLE	MKVIC  -  MAKE A VIDEO INTENSITY CONTOUR  -  AUGUST 1972.
00200	COMMENT/
00300	
00400	MEMORY:
00500	
00600	    TVBUF        216 lines of 288 columns.	36 - 288 - 62,208.
00700	    PAC         1728 words - 62208 bits.	18 - 144 - 31,104.
00800	    HSEG        1729 words.			 6 -  48 - 10,368.
00900	    VSEG        1736 words.			 4 -  32 -  6,912.
01000							 1 -   8 -  1,728.
01100	PROCESS:
01200	
01700		MKVICS		make video intensity contours.
01800		MKVIC		make a single contour.
01900	
02000		THRESHOLD	Generate 1-bit Image.
02100		PACXOR		Rook's move exclusive OR'ing.
02200	
02300		PIXPTR		TV picture byte pointer.
02400		VICONT		contrast of contours.
02500		ARCONT		ARC segment Contrast.
02600	
02700		MKARCS		Make Arcs - width proportional to constrast.
02800	
02900		FARCL		Fit Arcs Linear.
03000		SPLARC		Spline Arcs Fit.
03100	
03200	/
03300	
03400	; ROW-COL FIXED POINT 0000.00 OPERATIONS.
03500		OPDEF FLO[FSC 225]
03600	
03700		EXTERN GETBLK,KLPGON
     

00100	;CONTROL FLAGS.
00200		INTERN FLGSIX,FLGARC,FLGBK
00300	
00400		FLGSIX:-1		;SIX BIT TELEVISON.
00500		FLGARC:-1		;ENABLE MAKE ARC SMOOTHING.
00600		FLGBK:-1		;ENABLE BABY KILLER.
00700		VCUT: 14		;VERTEX CONTRAST THRESHOLD.
00800	
00900	;ARC WIDTH PROPORTIONAL TO CONTRAST TABLE FOR MKARCS.
01000	ARCWID:
01100		FOR I←0,5{1.0↔}
01150		FOR I←6,12{1.0↔}
01200		FOR I←13,17{1.0↔}
01300		FOR I←20,37{1.0↔}
01400		FOR I←40,77{0.7↔}
01500		0
     

00100	;LINK NAMES.
00200	
00300		RC←←-1
00400		DEFINE ROW(A,Q){CAR A,-1(Q)}↔DEFINE ROW.(A,Q){DIP A,-1(Q)}
00500		DEFINE COL(A,Q){CDR A,-1(Q)}↔DEFINE COL.(A,Q){DAP A,-1(Q)}
00600	
00700		DEFINE CONT(A,Q){NIP A,0(Q)}↔DEFINE CONT.(A,Q){DIP A,0(Q)}
00800		DEFINE ARC(A,Q){CDR A,0(Q)} ↔ DEFINE ARC.(A,Q){DAP A,0(Q)}
00900	
01000		DEFINE CW (A,Q){CAR A,1(Q)} ↔ DEFINE CCW (A,Q){CDR A,1(Q)}
01100		DEFINE CW.(A,Q){DIP A,1(Q)} ↔ DEFINE CCW.(A,Q){DAP A,1(Q)}
01200	
01300		DEFINE PED(A,Q){CAR A,1(Q)}
01400		DEFINE PED.(A,Q){DIP A,1(Q)}
     

00100	INTERN HEADER,TVBUF
00200		HEADER:	BLOCK =10
00300		TVBUF:	BLOCK =10368
00400		PAC:	BLOCK =1728
00500		VSEG:	BLOCK =1729
00600		HSEG:	BLOCK =1736
00700		ISAVED: 0
00800	
00900	;WINDOW FRAME POLYGON.
01000	INTERN PGON0
01100	PGON0:	.+2
01200	BEGIN
01300		4↔	0↔XWD W,0↔XWD .-2,.-2		;PGON BLOCK.
01800	
01900		0↔		   W: 0↔	XWD N,S↔0
02000		=216B11↔	   S: 0↔	XWD W,E↔0
02100		=216B11 + =288B29↔ E: 0↔	XWD S,N↔0
02200		=288B29↔	   N: 0↔	XWD E,W↔0
02300	
02400	BEND
     

00100	;MAKE VIDEO INTENSITY CONTOURS.
00200	SUBR(MKVICS)
00300	BEGIN MKVICS
00400		LAC 1,ARG2↔DAC 1,Q0#
00500		LAC 1,ARG1↔ANDCMI 1,377↔DAC 1,Q1#
00600		SETZM LEVEL#
00700	
00800	;FIND AN INTENSITY CONTOUR ENABLE BIT OR EXIT.
00900	L0:	LAC 0,Q0↔LAC 1,Q1
01000	L1:	AOS 2,LEVEL↔LSHC 0,1↔JUMPL L2
01100		SKIPE 0↔GO L1↔SKIPE 1↔GO L1↔POP2J
01200	L2:	DAC 0,Q0↔DAC 1,Q1
01300	
01400	;MAIN VIC CREATION SEQUENCE.
01500		PUSH P,LEVEL
01600		PUSHJ P,THRESH
01700		PUSHJ P,PACXOR
01800	L3:	PUSHJ P,MKVIC	;Make a single contour loop.
01900		JUMPE 1,L0	;no more contours at this level.
02000		DAC 1,P1#
02100		PUSH P,1
02200		PUSHJ P,VICONT	;VIC-CONTRAST.
02300	
02400	;THE BABY KILLER.
02500	;Eliminate Insignificant Contours - small low contrast.
02600		SKIPN FLGBK↔GO .+8
02700		LAC 1,P1
02800		LACM -1(1)
02900		CAIL =10↔GO .+4
03000		PUSH P,P1↔PUSHJ P,KLPGON↔GO L3
03100	
03200	;Smooth VIC into a loop of ARC segments.
03300		LAC 1,P1↔SKIPN FLGARC↔GO L4	;MAKE ARC ENABLED ?
03400		PUSHJ P,MKPAP	;Proto Arc Polygon.
03500		DAC 1,P2#
03600		PED 1,1↔DAC 1,V1#
03800		CCW 1,1↔DAC 1,V2#
03900		PUSH P,V1↔PUSH P,V2↔PUSHJ P,MKARCS
04000		PUSH P,V2↔PUSH P,V1↔PUSHJ P,MKARCS
04300		PUSH P,P1↔PUSHJ P,KLPGON
04350	
04400	;PUT P2 INTO THE PGON-RING.
04500		LAC 1,P2
04600	L4:	LAC 2,PGON0 ↔ CAR 3,2(2)
04700		DIP 3,2(1)↔DAP 1,2(3)
04800		DAP 2,2(1)↔DIP 1,2(2)
04900		GO L3
05000	BEND
     

00100	;MKVIC  -  MAKE A VIDEO INTENSITY CONTOUR  -  AUGUST 1972.
00200	;PGON ← MKVIC;
00300	SUBR(MKVIC)
00400	BEGIN MKVIC
00500	
00600		ACCUMULATORS{A2,A3,RC.,MASK,I,PTR,D,E,V}
00700		LAC I,ISAVED
00800		CDR PTR,ARG1
00900		SLACI I↔HRRI PAC↔DAC PACPTR#; PAC POINTER INDEXED BY I.
01000	
01100	;FIND THE ROW & COL OF THE UPPER LEFT MOST VSEG.
01200	L1:	SKIPE 1,VSEG(I)↔GO L2
01300		AOS I↔CAIE I,=1728↔GO L1
01400		SETZ 1,↔POP0J;EMPTY.
01500	
01600	L2:	DAC I,ISAVED↔JFFO 1,.+1↔SLACI MASK,400000
01700		MOVNS 2↔LSH MASK,(2)↔MOVNS 2
01800		LAC RC.,I↔ANDI RC.,7↔IMULI RC.,=36↔ADD RC.,2	;COLUMN.
01900		LAC I↔LSH -3↔DIP RC.↔LSH RC.,6			;ROW.
02000	
02100	;DISTINGUISH BLOBS FROM HOLES.
02200		SETZM HOLE#
02300		TDNN MASK,@PACPTR		;HOLE OR BLOB ?
02400		SETOM HOLE#			;HOLE'A'COMING.
02500	
02600	;...AND HEAD SOUTH.
02700	
02800		DAC  RC.,RCMIN#
02900		SETZM RCMAX#
03000		SETZ V,↔SETZM ECNT#
03100		PUSHJ P,FOLLOW
03200		LAC V,V0
03300		CCW. V,E↔CW. E,V
03400	
03500	;MAKE & RETURN VIC POLYGON.
03600	
03700		SETQ(PTR,{GETBLK})
03800		LAC 1,ECNT
03900		SKIPE HOLE#↔MOVNS 1 		;-CNT INDICATES A HOLE.
04000		DAC 1,-1(PTR)
04100		CCW E,V
04200		DIP E,1(PTR)
04300		LAC 1,PTR
04400	L3:	POP0J
     

00100	;THE SUB-OPERATIONS OF MKVIC.
00200	
00300	DEFINE	TRY (SEG,YES) {
00400		LAC SEG(I)↔TDZN MASK↔GO .+3↔DAC SEG(I)↔GO YES}
00500	DEFINE	LEFT	{SUBI RC.,100↔ROT MASK,1↔CAIN MASK,1↔SOS I}
00600	DEFINE	RIGHT	{ADDI RC.,100↔ROT MASK,-1↔SKIPG MASK↔AOS I}
00700	DEFINE	UP 	{SUB RC.,[1B11]↔SUBI I,8}
00800	DEFINE	DOWN  	{ADD RC.,[1B11]↔ADDI I,8}
00900	DEFINE	DEL $ (A,B){LAC D,[XWD 0$A$30,0$B$30]}
01000	
01100	;CREATE NEW EDGE AND VERTEX OF A VIC.
01200	TURN:	0
01300		AOS TURNS#
01400		ADD D,RC.
01500		AOS 2,ECNT
01600	
01700	;VERTEX
01800		CALL GETBLK
01900		SKIPN V↔GO[DAC 1,V0#↔DAC 1,V↔GO T2]
02000		DAC 1,V
02200		CCW. V,E↔CW. E,V
02300	T2:	DAC D,RC(V)
02400		CAMLE D,RCMAX
02500		GO[DAC D,RCMAX↔DAC V,V1#↔GO .+1]
02700	;EDGE
02900		DAC V,E
03200		GO @TURN
     

00100	;MAKE PROTO ARC POLYGON USING V0 AND V1.
00200	SUBR(MKPAP)
00300		AV1←MASK↔AV2←I
00400		CALL GETBLK↔DAC 1,PTR
00500		CALL GETBLK↔DAC 1,AV1
00600		CALL GETBLK↔DAC 1,AV2
00700		CCW. AV1,AV2↔CW. AV1,AV2
00800		CCW. AV2,AV1↔CW. AV2,AV1
00900	;UPPER MOST LEFT.
01000		LAC 1,V0↔ARC. 1,AV1↔ARC. AV1,1
01100		LAC RC(1)↔DAC RC(AV1)
01200	;LOWER MOST RIGHT.
01300		LAC 2,V1↔ARC. 2,AV2↔ARC. AV2,2
01400		LAC RC(2)↔DAC RC(AV2)
01500	
01600		PED. AV1,PTR
01700		LAC 1,PTR
01800		POP0J
     

00100	;THE ALCHEMIST OF MKVIC -
00200	;	- convert lead into golden line segments.
00300	
00400	NORTH:	ADD D,[1B11]↔JSR TURN
00500	NORTH2:	LEFT↔DEL(+,-)↔	TRY HSEG,WEST
00600		RIGHT↔UP↔	TRY VSEG,NORTH2
00700		DOWN↔DEL(+,+)↔	TRY HSEG,EAST↔FATAL(NORTH)
00800	NORTH3:	JSR TURN↔LEFT
00900	NORTH4:	UP↔DEL(+,-)↔	TRY HSEG,WEST↔GO NORTH4
01000	
01100	
01200	WEST:	ADDI D,100↔JSR TURN
01300	WEST2:	CAMN RC.,RCMIN↔POPJ P,;TRY FOR E.O.VIC.
01400	FOLLOW:	DEL(+,+)↔	TRY VSEG,SOUTH
01500		LEFT↔		TRY HSEG,WEST2
01600		RIGHT↔UP↔DEL(-,+)↔TRY VSEG,NORTH↔FATAL(WEST)
01700	
01800	
01900	SOUTH:	JSR TURN
02000	SOUTH2:	DOWN↔DEL(-,+)
02100		CAR RC.↔CAIN =216B29↔GO EAST3
02200				TRY HSEG, EAST
02300				TRY VSEG,SOUTH2
02400		LEFT↔DEL(-,-)↔	TRY HSEG,WEST↔	FATAL(SOUTH)
02500	
02600	
02700	EAST:	JSR TURN
02800	EAST2:	RIGHT↔DEL(-,-)
02900		CDR RC.↔CAIN =288B29↔GO NORTH3
03000		UP↔		TRY VSEG,NORTH
03100		DOWN↔		TRY HSEG,EAST2
03200		DEL(+,-)↔	TRY VSEG,SOUTH↔FATAL(EAST)
03300	EAST3:	JSR TURN↔UP
03400	EAST4:	RIGHT↔DEL(-,-)
03500		CDR RC.↔CAIN =288B29↔GO[DOWN↔GO NORTH3]
03600				TRY VSEG,NORTH↔GO EAST4
03700	BEND
     

00100	;PACXOR - Do rook's exclusive OR'ing.
00200	SUBR(PACXOR)
00300	BEGIN PACXOR
00400		I←2
00500		SLACI PAC↔LAPI HSEG↔BLT HSEG+=1727
00600		SLACI PAC↔LAPI VSEG↔BLT VSEG+=1727
00700		SETZ I,
00800		HRRI PAC↔DAP L+2
00900	L:	TRNN I,7↔SETZ 1,↔LAC PAC(I)
01000		XORM HSEG+8(I)	; HSEG bits are above PAC bits.
01100		ROTC -1↔ROT 1,1
01200		XORM VSEG(I)	; VSEG are left of PAC bits.
01300		AOS I
01400		CAIE I,=1728
01500		GO L
01600		SETZM ISAVED
01700		POP0J
01800	BEND
     

00100	;THRESHOLD(CUT)  -  pre-Foonly Version.
00200	SUBR(THRESH)
00300	BEGIN THRESH
00400		I←13 ↔ J←14 ↔ PTR←15
00500		LAC [XWD L,2]↔BLT 11
00600		LAP 4,ARG1↔SLACI I,-=1728
00700		HRLZI PTR,440600  ; =36 BITS TO GO, 6 BITS PER BYTE.
00800		SKIPN FLGSIX↔ HRLZI PTR,440400  ;  4 BITS PER BYTE.
00900		HRRI PTR,TVBUF
01000		HRRI 7,PAC↔GO 2
01100	
01200	;ACCUMULATOR LOOP.
01300	L:	MOVEI J,=36	;2
01400		ILDB PTR	;3
01500		SUBI ;CUT	;4
01600		ROTC 1		;5
01700		SOJG J,3	;6
01800		SETCAM 1,PAC(I) ;7
01900		AOBJN I,2	;10
02000		POP1J		;11
02100	BEND
02200	
02300	SUBR(HISTOGRAM)
02400	BEGIN HISTOGRAM
02500		EXTERN HISTO,DPYHIS
02600		PTR←15
02700	
02800		LAC 1,HISTO↔SETZM(1)	;CLEAR HISTOGRAM.
02900		HRLZ 1↔ADDI 1(1)↔BLT =65(1)
03000	
03100		LAC[XWD L,2]↔BLT 5
03200	
03300		HRLZI PTR,440600↔SKIPN FLGSIX
03400		HRLZI PTR,440400↔HRRI PTR,TVBUF
03500		MOVEI =62208	;NUMBER OF PIXELS IN A PICTURE.
03600		ADD 3,HISTO	;HISTOGRAM POINTER.
03700		JRST 2
03800	
03900	;ACCUMULATOR LOOP.
04000	L:	ILDB 1,PTR	;2
04100		AOS 1(1)	;3
04200		SOJG 2		;4
04300		GO .+1		;5
04400	
04500		CALL(DPYHIS)
04600		POP0J
04700	BEND
     

00100	;PTR ← PIXPTR(ROW,COL)   -  COMPUTE PICTURE BYTE POINTER.
00200	SUBR(PIXPTR)
00300	BEGIN PIXPTR
00400		;AC-0 PC return address for JSP entry.
00500		;AC-1 Row argument, byte pointer value.
00600		;AC-2 Column argument.
00700		;AC-3 get clobbered.
00800		SETZ↔LAC 1,ARG2↔LAC 2,ARG1
00900	;PIXPTR+3:
01000		SKIPN FLGSIX↔JRST L
01100	;SIX BIT BYTES  -  TVBUF + ROW*48 + (COL DIV 6).
01200		IMULI 1,=48
01300		ADDI 1,TVBUF
01400		IDIVI 2,6
01500		ADD  1,2
01600		HLL   1,[POINT 6,0,-1 ↔ POINT 6,0,05 ↔ POINT 6,0,11
01700			 POINT 6,0,17 ↔ POINT 6,0,23 ↔ POINT 6,0,29](3)
01800		JUMPN@↔POP2J
01900	;FOUR BIT BYTES  - TVBUF + ROW*32 + (COL DIV 9).
02000	L:	ASH 1,5
02100		ADDI 1,TVBUF
02200		IDIVI 2,9
02300		ADD 1,2
02400		HLL 1,[POINT 4,0,-1 ↔ POINT 4,0,03 ↔ POINT 4,0,07
02500		       POINT 4,0,11 ↔ POINT 4,0,15 ↔ POINT 4,0,19
02600		       POINT 4,0,23 ↔ POINT 4,0,27 ↔ POINT 4,0,31]
02700		JUMPN@↔POP2J
02800	BEND
     

00100	;VICONTRAST(PGON)  -  HORIZONTAL/VERTICAL CONTRAST.
00200	SUBR(VICONT)
00300	BEGIN VICONT
00400		R←1 ↔ C←2 ↔ R2←10 ↔ C2←11 ↔ E←13 ↔ V1←14 ↔ V2←15
00500	
00600	;INITIALIZATION - SETUP FIRST EDGE OF THE PGON.
00700	
00800		LAC E,ARG1 ↔ PED E,E
00900		DAC E,E0# ↔  LAC V2,E
01000		LAC RC(V2)↔ADD [XWD 30,30]
01100		CAR R2,↔LSH R2,-6
01200		CDR C2,↔LSH C2,-6
01300	
01400	;ADVANCE CCW ALONG PGON.
01500	
01600	L0:	DAC V2,V1 ↔ DAC R2,R1# ↔ DAC C2,C1# ↔ CCW V2,E
01700		LAC RC(V2)↔ADD [XWD 30,30]
01800		CAR R2,↔LSH R2,-6   ↔   CDR C2,↔LSH C2,-6
01900	
02000	;SELECT HORIZONTAL OR VERTICAL.
02100	
02200		CAMN R2,R1 ↔ JRST HORZNT
02300		CAMN C2,C1 ↔ JRST VERTCL
02400		OUTSTR[ASCIZ/VICONT ¬HV./]
02500	L1:	LAC E,V2↔CAME E,E0↔JRST L0
02600		POP1J
     

00100	;HORIZONTAL CASE LEFT TO RIGHT.
00200	HORZNT:
00300		LAC R,R1
00400		LAC C,C1 ↔ LAC 5,C2
00500		CAML C,C2 ↔ EXCH C,5	;GET FAR LEFT IN C.
00600		LAC 6,C ↔ SUB 5,C	;COLUMN DIFFERENCE.
00700	
00800	;SETUP TVBUF BYTE POINTERS 1 INSIDE, 3 OUTSIDE.
00900		JSP PIXPTR+3↔LAC 3,1
01000		SUBI 1,=32 ↔ SKIPE FLGSIX ↔ SUBI 1,=16
01100		CAME 6,C1 ↔ EXCH 1,3 ↔ LAC 6,5
01200	
01300	;ACCUMULATE INTENSITIES ALONG THE EDGE.
01400		SETZB 2,4↔ILDB 1↔ADDM 2↔ILDB 3↔ADDM 4↔  SOJG 5,.-4
01500	
01600	;SET ABOVE THE TOP OR BELOW THE BOTTOM TO UTTER DARKNESS.
01700		SKIPE R2↔CAIN R2,=216↔SETZ 4,
01800	
01900	;COMPUTE AND SAVE AVERAGE INTENSITIES AND CONTRAST.
02000		IDIV 2,6;DIP 2,2(E)	;INSIDE CCW V1 TO V2.
02100		IDIV 4,6;DAP 4,2(E)	;OUTSIDE CW V1 TO V2.
02200		SUB 2,4↔CONT. 2,E	;CONTRAST INSIDE MINUS OUTSIDE.
02300		JRST L1
02400	
02500	;VERTICAL CASE TOP TO BOTTOM.
02600	VERTCL:
02700		LAC C,C1 ↔ LAC R,R1 ↔ LAC 5,R2
02800		CAML R,R2 ↔ EXCH R,5	;GET UPPERMOST ROW.
02900		LAC 6,R ↔ SUB 5,R	;ROW DIFFERENCE.
03000	
03100	;SETUP TVBUF BYTE POINTERS 1 INSIDE, 3 OUTSIDE.
03200		JSP PIXPTR+3↔TLO 1,7↔LAC 3,1	;INDEXED BY AC-7.
03300		IBP 1 ↔ TLC  3,(44B5)	;FLIP 'EM.
03400		TLNN 3,(44B5)↔SOSA 3	;DECREM BYTE POINTER.
03500		TLC  3,(44B5)		;STATUS QUO ANTE.
03600		CAME 6,R1 ↔ EXCH 1,3 ↔ LAC 6,5
03700	
03800	;ACCUMULATE INTENSITIES ALONG THE EDGE.
03900		SETZB 2,4↔SETZ 7,
04000		MOVEI =32↔SKIPE FLGSIX↔MOVEI =48↔DAP .+5    ;ROW WORD WIDTH.
04100		LDB 1↔ADDM 2↔LDB 3↔ADDM 4↔ADDI 7,0↔  SOJG 5,.-5
04200	
04300	;SET BEYOND THE LEFT OR RIGHT TO UTTER DARKNESS.
04400		SKIPE C2↔CAIN C2,=288↔SETZ 4,
04500	
04600	;COMPUTE AND SAVE AVERAGE INTENSITIES AND CONTRAST.
04700		IDIV 2,6;DIP 2,2(E)	;INSIDE CCW V1 TO V2.
04800		IDIV 4,6;DAP 4,2(E)	;OUTSIDE CW V1 TO V2.
04900		SUB 2,4↔CONT. 2,E	;CONTRAST INSIDE MINUS OUTSIDE.
05000		JRST L1
05050		LIT↔VAR
05100	BEND
     

00100	; ARC CONTRAST.
00200	SUBR(ARCONT)
00300	BEGIN ARCONT
00400		ACCUMULATORS{U1,U2,V1,V2,E,E0,N}
00500	
00600		LAC E,ARG1	;FIRST EDGE OF AN ARC PGON.
00700		CAR E,1(E)
00800		DAC E,E0
00900		CW V2,E
01000	
01100	L1:	LAC V1,V2↔CCW V2,E
01200		ARC U1,V1↔ARC U2,V2
01300	
01400		SETZ↔MOVEI N,1
01500	
01600		CCW U1,U1↔ADD 2(U1)↔CCW U1,U1
01700		CAME U1,U2↔AOJA N,.-4
01800	
01900		CAR 2,0 ↔ IDIV 2,N ↔ DIP 2,2(E)
02000		CDR 0,0 ↔ IDIV 0,N ↔ DAP 0,2(E)
02100		SUB 2,0 ↔ DAP  2,-1(E)
02200	
02300		CCW E,V2↔CAME E,E0↔JRST L1
02400	
02500	;VERTEX CONTRAST.
02600	L2:	NAP 0,-1(E)↔CCW V1,E
02700		CCW E,V1↔NAP 1,-1(E)
02800		SUB 1,0↔DAP 1,2(V1)
02900	
03000		NAP 1,-1(E)↔MOVMS↔MOVMS 1
03100		CAMG 0,1↔EXCH 0,1
03200		SETO 2,↔CAML 0,VCUT↔CAML 1,VCUT↔SETZ 2,
03300		DIP 2,2(V1)			;MARK TRANSITIONAL VERTEX.
03400	
03500		CAME E,E0↔JRST L2↔POP1J
03600	BEND
     

00100	;SUBR MKARCS (ARCV1,ARCV2)  -  FROM U1 CCW TO U2.
00200	SUBR(MKARCS)
00300	BEGIN MKARCS
00400		EXTERN SQRT; CLOBBERS AC1 THRU AC4.
00500		ACCUMULATORS{D,U1,U2,V1,V2,A,B,C,U,V}
00600		LAC V1,ARG2↔LAC V2,ARG1↔SETZM AVCNT#
00700	
00800	;CHECK FOR TRIVAIL CASE.
00900	L0:	ARC U1,V1↔ARC U2,V2
01000		CCW 0,U1↔CAMN 0,U2↔GO L3
01100	
01200	;COMPUTE NORMALIZED ARC EDGE COEFFICIENTS.
01300		ROW A,V1↔FLO A,		; A ← Y1.
01400		COL B,V2↔FLO B,		; B ← X2.
01500		COL C,V1↔FLO C,		; C ← X1.
01600		ROW D,V2↔FLO D,		; D ← Y2.
01700		LAC 1,B↔FMPR 1,A	; 1 ← X2*Y1.
01800		FSBR A,D↔FSBR B,C	; A ← Y1-Y2.   B ← X2-X1.
01900		FMPR C,D↔FSBR C,1	; C ← X1*Y2 - X2*Y1.
02000		LAC 0,A↔FMPR 0,0↔LAC 1,B↔FMPR 1,1↔FADR 1,0
02100		CALL SQRT,1↔FDVR A,1↔FDVR B,1↔FDVR C,1
02200	
     

00100	;SET 'EM UP FOR AN ARC PASS.
00200		ARC U1,V1↔ARC U2,V2
00300		SETZM DMAX#↔SETZM DMIN#
00400		SETZM VMAX#↔SETZM VMIN#
00500		SETZM MAXCON#
00600	;GO FROM U1 CCW TO U2 AND FIND THE U FURTHEST OFF THE ARC-EDGE.
00700	L1:	CCW U1,U1↔CAMN U1,U2↔GO L2
00800		COL 0,U1↔FLO 0,↔ROW 1,U1↔FLO 1,
00900		FMPR 0,A↔FMPR 1,B↔LAC D,C↔FADR D,0↔FADR D,1
01000		CAMGE D,DMIN↔GO [DAC U1,VMIN↔DAC D,DMIN↔GO .+1]
01100		CAMLE D,DMAX↔GO [DAC U1,VMAX↔DAC D,DMAX↔GO .+1]
01200	;KEEP TRACK OF MAXIMUM EDGE CONTRAST ALONG ARC.
01300		CONT 0,V1↔MOVM↔CAMLE MAXCON↔DAC MAXCON↔GO L1
01400	
01500	;WHEN EXTREMA EXCEED ARCWID[MAXCON] THEN FORM ARC-POINTS.
01600	L2:	LAC U,VMIN↔LACM DMIN
01700		CAMGE DMAX↔LAC U,VMAX
01750		CAMGE DMAX↔LAC DMAX
01800		LAC 1,MAXCON↔CAMGE ARCWID(1)↔GO L3
01900		
02000	;OLDE ESPLIT: →CW→ V2...D...AV...E...V1 ←CCW←
02200		CALL GETBLK↔DAC 1,V↔AOS AVCNT
02300		ARC. U,V↔ARC. V,U
02350		LAC RC(U)↔DAC RC(V)
02400		CCW. V,V1↔CW. V1,V
02500		CCW. V2,V↔CW. V,V2
02700		LAC V2,V↔GO L0
02800	
02900	;ADVANCE CCW AN ARC-EDGE OR EXIT.
03000	L3:	CAMN V2,ARG1↔POP2J
03100		LAC V1,V2↔CCW V2,V2
03150		GO L0
03200	BEND
     

00100	;FARCL(PGON) - FIT ARCS LINEAR.
00200	SUBR(FARCL)
00300	BEGIN FARCL
00400		X←1
00500		ACCUMULATORS{Y,SX,SY,XX,YY,XY,N,E,U1,U2,V1,V2}
00600		DAC 12,AC12
00700	
00800	;Clear the Locus of all the Arc Vertices.
00900		LAC E,ARG1↔CAR E,1(E)↔DAC E,E0#
01000		CCW V1,E ↔ SETZM -1(V1)
01100		CCW E,V1 ↔ CAME E,E0↔JRST .-4
01200	
01300	;Advance along Polygon.
01400		CW V2,E
01500	L1:	LAC V1,V2↔CCW V2,E
01600		ARC U1,V1↔ARC U2,V2
01700		CW U1,U1↔CW U1,U1
01800		CW U1,U1↔CW U1,U1
01900		CW U1,U1↔CW U1,U1
02000		CCW U2,U2↔CCW U2,U2
02100		CCW U2,U2↔CCW U2,U2
02200		CCW U2,U2↔CCW U2,U2
02300	
02400	;Arc Scan Initialization.
02500		LAC [XWD SX,SY]↔SETZ SX,↔BLT N↔JRST .+3
02600	;Advance along VIC within the ARC.
02700	L2:	CCW U1,U1↔CCW U1,U1
02800	;Accumulate a Point.
02900		CDR X,-1(U1)↔FLO X,↔CAR Y,-1(U1)↔FLO Y,
03000		FAD SX,X ↔ FAD SY,Y
03100		LAC X ↔ FMP Y ↔ FAD XY,0
03200		FMP X,X ↔ FAD XX,X
03300		FMP Y,Y ↔ FAD YY,Y
03400		CAME U1,U2↔AOJA N,L2↔AOS N
     

00100	;Compute symetric least squares line coefficients.
00200	; Q ← N*XY - SY*SX.
00300	; A ← Q + SY*SY - N*YY.
00400	; B ← Q + SX*SX - N*XX.
00500	; C ← SX*YY + SY*XX - XY*(SX+SY).
00600	
00700	L3:	LAC 2,SX↔FMP 2,YY
00800		LAC 0,SY↔FMP 0,XX↔FAD 2,0
00900		LAC SX↔FAD SY↔FMP XY↔FSB 2,0↔DAC 2,CCCC#
01000	
01100		FSC N,233↔FMP XX,N↔FMP XY,N↔FMP YY,N	;all the N terms.
01200		LAC SX↔FMP SY↔FSB XY,0				;Q in XY.
01300	
01400		FMP SY,SY↔FAD SY,XY↔FSB SY,YY↔DAC SY,AAAA#
01500		FMP SX,SX↔FAD SX,XY↔FSB SX,XX↔DAC SX,BBBB#
01600	
01700		FMP SY,SY↔FMP SX,SX↔FAD SX,SY
01800		SLACI(1.0)↔FDVR SX↔DAC QQQQ#	;PSEUDO NORMALIZATION.
01900	
02000	;Solve for the Locii where perpendiculars dropped from
02100	;the arc-edge hit the fitted line.
02200	; Q ← 1/(A*A + B*B).
02300	; D ← (B*X1 - A*Y1).
02400	; X ← (B*D - A*C)*Q.
02500	; Y ←-(A*D + B*C)*Q.
02600	
02700	L4:	ARC U1,V1
02800		CDR X,-1(U1)↔FLO X,↔CAR Y,-1(U1)↔FLO Y,
02900		FMP X,BBBB↔FMP Y,AAAA↔FSBR X,Y↔LACN Y,X		;DDDD.
03000		FMP X,BBBB↔FMP Y,AAAA
03100		LAC AAAA↔FMP CCCC↔FSBR X,↔FMPR X,QQQQ↔247040226000;FIX
03200		LAC BBBB↔FMP CCCC↔FSBR Y,↔FMPR Y,QQQQ↔247100226000
03300		DIP Y,X↔ADDM X,-1(V1)
03400	
03500		ARC U2,V2
03600		CDR X,-1(U2)↔FLO X,↔CAR Y,-1(U2)↔FLO Y,
03700		FMP X,BBBB↔FMP Y,AAAA↔FSBR X,Y↔LACN Y,X		;DDDD.
03800		FMP X,BBBB↔FMP Y,AAAA
03900		LAC AAAA↔FMP CCCC↔FSBR X,↔FMPR X,QQQQ↔247040226000;FIX
04000		LAC BBBB↔FMP CCCC↔FSBR Y,↔FMPR Y,QQQQ↔247100226000
04100		DIP Y,X↔ADDM X,-1(V2)
04200	
04300		CCW E,V2↔CAME E,E0↔JRST L1
04400		LAC 12,AC12↔POP1J
04500	BEND
04600	END